Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/winsweep/winsweep.frm

Text File | 1995-05-08 | 10KB | 375 lines

VERSION 2.00
Begin Form Form1
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0FFC0&
   Caption         =   "WinSweep 1.3 - (c)1991 Nils Segerdahl"
   ClientHeight    =   4815
   ClientLeft      =   240
   ClientTop       =   1395
   ClientWidth     =   8760
   Height          =   5220
   Icon            =   WINSWEEP.FRX:0000
   Left            =   180
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4815
   ScaleWidth      =   8760
   Top             =   1050
   Width           =   8880
   Begin FileListBox File1
      BackColor       =   &H00C0C0C0&
      Height          =   2370
      Hidden          =   -1  'True
      Left            =   7080
      System          =   -1  'True
      TabIndex        =   0
      Top             =   2280
      Width           =   1575
   End
   Begin DirListBox Dir1
      BackColor       =   &H00C0C0C0&
      Height          =   1575
      Left            =   7080
      TabIndex        =   2
      Top             =   600
      Width           =   1575
   End
   Begin TextBox Text1
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   4095
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Text            =   " "
      Top             =   600
      Width           =   6855
   End
   Begin DriveListBox Drive1
      BackColor       =   &H00C0C0C0&
      Height          =   315
      Left            =   7320
      TabIndex        =   3
      Top             =   120
      Width           =   1335
   End
   Begin CommandButton Command6
      Caption         =   "&?"
      Height          =   375
      Left            =   6720
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   120
      Width           =   375
   End
   Begin CommandButton Command2
      Caption         =   "&Quit"
      Height          =   375
      Left            =   6000
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   120
      Width           =   615
   End
   Begin CommandButton Command5
      Caption         =   "&Run"
      Height          =   375
      Left            =   5400
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   120
      Width           =   495
   End
   Begin CommandButton Command4
      Caption         =   "&Copy"
      Height          =   375
      Left            =   4680
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   120
      Width           =   615
   End
   Begin CommandButton Command3
      Caption         =   "&Delete"
      Height          =   375
      Left            =   3840
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   120
      Width           =   735
   End
   Begin CommandButton Command1
      Caption         =   "&Save"
      Height          =   375
      Left            =   3000
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   120
      Width           =   735
   End
   Begin TextBox Text2
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   600
      TabIndex        =   8
      TabStop         =   0   'False
      Text            =   " "
      Top             =   120
      Width           =   2295
   End
   Begin PictureBox Picture1
      BackColor       =   &H00C0FFC0&
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      Picture         =   WINSWEEP.FRX:0302
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   0
      Width           =   495
   End
End


Sub Command1_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    If (filesize > FILMAX) Then
    MsgBox "File wold be truncated!"
    Exit Sub
    End If
    tmp$ = "Save file " + file1.filename + " ? "
    rep = MsgBox(tmp$, 36, "SAVE File")
    If rep = 6 Then
    tmp$ = file1.filename
    dotpos = InStr(1, tmp$, ".")
    tmp$ = Left$(tmp$, dotpos)
    On Error GoTo errhand
    Kill tmp$ + "bak"
    On Error GoTo 0
    Name file1.filename As tmp$ + "bak"
    Open file1.filename For Binary As #1
    textstr$ = text1.text
    Put #1, , textstr$
    Close #1
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
    Exit Sub
errhand:
    Resume Next
End Sub


Sub Command2_Click ()
    tmp$ = "If you like this program, please send" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "some money (eg. 25$) to me:" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + " " + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "Nils Segerdahl" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "PrΣstgσrdsgatan 19B" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "S-752 30 Upsala, SWEDEN" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + " " + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + " " + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "TERMINATE?" + Chr$(13) + Chr$(10)
    resp% = MsgBox(tmp$, 20, "QUIT")
    If resp% = 6 Then
       End
    End If
End Sub

Sub Command3_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    tmp$ = "Delete file " + file1.filename + " ? "
    rep = MsgBox(tmp$, 36, "Delete File")
    If rep = 6 Then
    Kill file1.filename
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
End Sub

Sub Command4_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    tmp$ = "Copy " + file1.filename + " to "
    tmp$ = InputBox$(tmp$, "Copy file", "")
    screen.mousepointer = 11
    If Len(tmp$) > 0 Then
       Open file1.filename For Binary As #1
       On Error GoTo errhand_cmd4
       Kill tmp$
       On Error GoTo 0
       Open tmp$ For Binary As #2
       i = LOF(1)
       text2.text = "Copying...."
       For j = 1 To i Step 512
        tmp$ = Input$(512, #1)
        Put #2, j, tmp$
       Next j
       text2.text = "Done"
       Close
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
    screen.mousepointer = 0
    Exit Sub
errhand_cmd4:
    Resume Next
End Sub

Sub Command5_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    tmp$ = Right$(file1.filename, 4)
    If tmp$ = ".exe" Or tmp$ = ".com" Or tmp$ = ".bat" Then
    res = Shell(file1.filename, 1)
    Else
    MsgBox "File not executable"
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
End Sub

Sub Command6_Click ()
    form2.Show

End Sub

Sub Dir1_Change ()
    screen.mousepointer = 11
    file1.path = dir1.path
    ChDir dir1.path
    On Error GoTo errh
    file1.listindex = 0
    On Error GoTo 0
    file1.SetFocus
    screen.mousepointer = 0
    Exit Sub

errh:
    Resume Next
End Sub

Sub Drive1_Change ()
    screen.mousepointer = 11
    dir1.path = drive1.drive
    ChDrive (drive1.drive)
    file1.listindex = 0
    file1.SetFocus
    screen.mousepointer = 0
End Sub

Sub errhand ()

End Sub

Sub File1_Click ()
    screen.mousepointer = 11
    filesize = 0
    txtstr$ = String$(FILMAX, " ")
    If Right$(file1.filename, 4) = ".exe" Then
    text2.text = ".EXE file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.filename, 4) = ".com" Then
    text2.text = ".COM file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.filename, 4) = ".bmp" Then
    text2.text = ".bmp file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.filename, 4) = ".dll" Then
    text2.text = ".DLL file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.f